Amiga Games 1996 July/Amiga Games 1996 #7.iso/rexx/packtool.dopus5

Text File | 1996-02-23 | 36KB | 901 lines

/*
Universal - Packertool
$VER: Packtool.Dopus5 1.0 (31.1.96) © by P.Kromarek sen.
----------------------------------------------------------------------------------
Aufruf als:
Knopf:
ARexx DOpus5:ARexx/Packtool.DOPus5 {Qp} [Pack|UnPack|Convert] [NOASK|ASK]
evtl.Packervorgabe [LZX|LHA|XPK|LHAMASH|LZXMASH|XMASH|DMS|DSQ] z.B.XPK-NUKE.100
Sonst nichts.(Wahlweise Ausgabe im Fenster).
----------------------------------------------------------------------------------
Dateitype --- Doppelklick:
ARexx DOpus5:ARexx/Packtool.DOPus5 {Qp} Show....{f}
Show(DSQ|PKA|PKX) benötigt auch keinerlei Ausgabeoption, die anderen
Showversionen benötigen Ausgabe im Fenster, ohne Schließsymbol.
Bei allen ShowXXX muß als als letztes Argument {f} mit angegeben werden!
Die ID der Dateitypen muß das Suffix beinhalten! z.B.[LHA|XPK|LZX|AMPK u.s.w.]
Die Priorität der LZX|LHA-Masher muß höher sein als die der normalen Packer!!
----------------------------------------------------------------------------------
TRACE (ALL)*/
OPTIONS RESULTS
OPTIONS FAILAT 99
SIGNAL ON SYNTAX;SIGNAL ON BREAK_C
PARSE ARG portname auftrag message crunch
ADDRESS VALUE portname
auftrag = UPPER(STRIP(auftrag,B,' "'))
loesch = 0
lwf = 0
a = 1
frage = 0
nachricht = 0
fresh = 0
lf = '0a'x
tr = D2C(34)
packer = 0
warn = 0
abbruch = 0
laufwerk = ""

lister query source
fenster_s = RESULT
lister query dest
fenster_d = RESULT
IF fenster_s = "RESULT" & LEFT(auftrag,4) ~= "SHOW" THEN DO
   dopus request '"Es ist kein Quellister aktiviert!!'||lf||'Bitte aktivieren, und dann nochmal." Ok'
   EXIT
END
IF fenster_d = fenster_s & LEFT(auftrag,4) ~= "SHOW"THEN DO
   dopus request '"Es ist kein Ziellister aktiviert!!'||lf||'Bitte aktivieren, und dann nochmal." Ok'
   EXIT
END
lister query fenster_s numselentries
anzahl = RESULT
lister query fenster_s path
pfad_s = RESULT
lister query fenster_d path
pfad_d = RESULT

IF LEFT(auftrag,4) ~= "SHOW" THEN DO
   ADDRESS COMMAND 'assign >NIL: Tooltemp: exists'
   ass = RC
   IF ass ~= 0 THEN DO
      ADDRESS COMMAND 'makedir >NIL: Ram:Packtemp'
      ADDRESS COMMAND 'assign >NIL: Packtemp: Ram:Packtemp'
   END
   IF ass = 0 THEN DO
      ADDRESS COMMAND 'makedir >NIL: Tooltemp:Packtemp'
      ADDRESS COMMAND 'assign >NIL: Packtemp: Tooltemp:Packtemp'
   END
   ADDRESS COMMAND 'assign >NIL: quelle: 'tr||pfad_s||tr
   ADDRESS COMMAND 'assign >NIL: ziel: 'tr||pfad_d||tr
END

SELECT
      WHEN auftrag = "UNPACK" THEN CALL ENTPACKEN
      WHEN auftrag = "CONVERT" THEN CALL WANDELN
      WHEN auftrag = "PACK" THEN CALL PACKEN
      OTHERWISE CALL zeige
END

SCHLUSS:
IF fresh = 0 THEN DO
   lister set fenster_d busy 0
   lister clear fenster_d abort 0
   lister read fenster_d tr||pfad_d||tr force
   lister refresh fenster_d full
END
lister set fenster_s busy 0
lister clear fenster_s abort 0
lister read fenster_s tr||pfad_s||tr force
lister refresh fenster_s full
ADDRESS COMMAND 'assign >NIL: Packtemp: remove'
IF ass ~= 0 THEN ADDRESS COMMAND 'delete >NIL: Ram:Packtemp ALL OUIET FORCE'
IF ass = 0 THEN ADDRESS COMMAND 'delete >NIL: Tooltemp:Packtemp ALL OUIET FORCE'
ADDRESS COMMAND 'assign >NIL: quelle: remove'
ADDRESS COMMAND 'assign >NIL: ziel: remove'
OPTIONS CACHE
ADDRESS
EXIT

ZEIGE:
fresh = 1
file = STRIP(message,B,' "')
IF crunch ~= "" & crunch ~= "CRUNCH" THEN file = tr||file||crunch
IF auftrag = "SHOWDMS" THEN DO
   ADDRESS COMMAND 'DMS VIEW '||file
END
IF auftrag = "SHOWDSQ" THEN DO
   ADDRESS COMMAND 'LZX -m -X0 -bo930 -q x '||file||' Files.dsq Ram:'
      IF EXISTS('Ram:Files.dsq') = 1 THEN DO
         'command AnsiRead Ram:Files.dsq'
         ADDRESS COMMAND 'wait 1'
      END
   ADDRESS COMMAND 'Delete >NIL: Ram:Files.dsq QUIET FORCE'
END
IF auftrag = "SHOWPKX" | auftrag = "SHOWPKA" THEN DO
   IF auftrag = "SHOWPKX" THEN ADDRESS COMMAND 'LZX -m -X0 -bo256 -q x '||file||' Files.pak Ram:'
   IF auftrag = "SHOWPKA" THEN ADDRESS COMMAND 'LHA -F -m -b256 -X -q x '||file||' Files.pak Ram:'
      IF EXISTS('Ram:Files.pak') = 1 THEN DO
         'command AnsiRead Ram:Files.pak'
         ADDRESS COMMAND 'wait 2'
      END
   ADDRESS COMMAND 'Delete >NIL: Ram:Files.pak QUIET FORCE'
END
IF auftrag = "SHOWPKD" THEN DO
   ADDRESS COMMAND 'PackDev VIEWFILE '||file
END
RETURN

WANDELN:
pause = 0
arc = 0
fragpack = 0
zzs = ""
lister set fenster_s busy 1
lister set fenster_d busy 1
anweisung = UPPER(STRIP(message,B,' "'))
IF anweisung = "NOASK" THEN loesch = 1
IF crunch ~= "" & crunch ~= "CRUNCH" THEN DO
   crunch = UPPER(STRIP(crunch,B,' "'))
   packer = LEFT(crunch,3)
   IF LENGTH(Crunch) >3 THEN subpack = SUBSTR(crunch,5)
   fragpack = 1
   SELECT
      WHEN packer = "LZX" THEN packer = 1
      WHEN packer = "LHA" THEN packer = 2
      WHEN packer = "XPK" THEN packer = 3
      WHEN packer = "DMS" THEN packer = 4
      WHEN packer = "ZOOM" THEN packer = 5
      OTHERWISE NOP
   END
END
IF anzahl < 1 THEN DO
   dopus request '"Oh Mann!: Irgendetwas solltest du schon anhaken!" OK'
   CALL schluss
END
a=0
zzx = " D B"
DO FOREVER
   a = a+1
   lister query fenster_s firstsel
   IF RC ~= 0 THEN LEAVE
   xfile = RESULT
   unpackfile = STRIP(xfile,B,' "')
   lister select fenster_s xfile 0
   dopus getfiletype 'quelle:'||xfile id
   packtyp = RESULT
   IF fragpack = 0 THEN DO
      dopus request '"Auf welches Packerformat soll konvertiert werden?" LZX|LHA|XPK|DMS|Zoom|DSQ|ENDE'
      packer = RC;fragpack = 1
   END
   IF packer = 0 THEN CALL schluss
   SELECT
      WHEN packer = 1 THEN hpck = "LZX"
      WHEN packer = 2 THEN hpck = "LHA"
      WHEN packer = 3 THEN hpck = "XPK"
      WHEN packer = 4 THEN hpck = "DMS"
      WHEN packer = 5 THEN hpck = "ZOM"
      WHEN packer = 6 THEN hpck = "DSQ"
   END
   IF packtyp = "XMS" THEN DO
      IF LEFT(drive,2) ~= "DF" THEN CALL drivetest
   END
   IF packtyp = "DMS" | packtyp = "XMS" | packtyp = "PKD" | packtyp = "ZOM" Then DO
      IF frage = 0 THEN CALL DRIVETEST
   END
   IF hpck = packtyp THEN DO
      dopus request '"Das File '||xfile||lf||'kannst DU besser kopieren!!" Ok'
      pause = 1
   END
   IF pause = 0 THEN DO
      CALL sense
      IF a = 1 THEN lister set fenster_s progress anzahl 'Konvertiere Archiv(e):'
      IF packtyp = "DMS" THEN DO
         say
         say "DMS ist bei der Arbeit!"
         say
      END
      lister set fenster_s progress count a
      IF packtyp ~= "ICON" THEN lister set fenster_s progress name 'Unpack: '||unpackfile
      SELECT
          WHEN packtyp = "DMS" THEN ADDRESS COMMAND 'DMS WRITE '||tr||'quelle:'||unpackfile||tr||' TO '||tr||drive||tr||' NOTEXT NOPAUSE <NIL: >NIL:'
          WHEN packtyp = "XMS" THEN ADDRESS COMMAND 'XMash WRITE '||tr||'quelle:'||unpackfile||tr||' TO '||tr||drive||tr
          WHEN packtyp = "PKD" THEN ADDRESS COMMAND 'PackDev '||tr||'quelle:'||unpackfile||tr||' '||tr||drive||tr||' ETDF NC NV'
          WHEN packtyp = "ZOM" THEN ADDRESS COMMAND 'zoom From '||tr||'quelle:'||unpackfile||tr||' To '||tr||drive||tr||' N'
          WHEN packtyp = "PKA" | packtyp = "PKX" | packtyp = "DSQ" | packtyp = "XDM" THEN NOP
          OTHERWISE arc = 1
      END
      IF arc = 1 THEN DO
         CALL sense
         SELECT
            WHEN packtyp = "LZX" THEN ADDRESS COMMAND 'LZX -m -3 -bo256 -X0 x '||tr||'quelle:'||unpackfile||tr||' Packtemp:'
            WHEN packtyp = "LHA" THEN ADDRESS COMMAND 'LHA -m -b256 x '||tr||'quelle:'||unpackfile||tr||' Packtemp:'
            WHEN packtyp = "AMPK" THEN ADDRESS COMMAND 'AMIPACK-X '||tr||'quelle:'||unpackfile||tr||' Packtemp:'
            WHEN packtyp = "ZIP" THEN ADDRESS COMMAND 'Unzip -o '||tr||'quelle:'||unpackfile||tr||' -d Packtemp:'
            OTHERWISE arc = 2
         END
      END
      IF RC >5 THEN CALL fehler
      IF pause = 1 THEN BREAK
      signal = 0
      IF packtyp = "PKA" | packtyp = "PKX" | packtyp = "DSQ" | packtyp = "XDM" THEN DO
         IF packer <3 | packer = 6 THEN signal = 1
      END
      IF arc = 0 & pause = 0 THEN DO
         IF packtyp = "PKX" | packtyp = "DSQ" | packtyp = "PKA" | packtyp = "XDM" THEN DO
            lister set fenster_s progress name 'Ich Entpacke:'||unpackfile
            IF packtyp = "PKX" | packtyp = "DSQ"| packtyp = "XDM" THEN ADDRESS COMMAND 'LZX -m -X0 x '||tr||'quelle:'||unpackfile||tr||' Packtemp:'
            IF packtyp = "PKA" THEN ADDRESS COMMAND 'LHA -F -m -X x '||tr||'quelle:'||unpackfile||tr||' Packtemp:'
            IF RC >5 THEN CALL fehler
            IF pause = 1 THEN BREAK
            IF packer <= 2 | packer = 6 THEN arc = 2
            CALL sense
            IF packtyp = "DSQ" THEN DO
               ADDRESS COMMAND 'rename >NIL: packtemp:Image.dsq to packtemp:Image.pak'
               ADDRESS COMMAND 'rename >NIL: packtemp:Files.dsq to packtemp:Files.pak'
            END
            IF EXISTS('Packtemp:xdm.pkd') = 1 THEN ADDRESS COMMAND 'rename >NIL: packtemp:xdm.pkd to packtemp:Image.pak'
            IF EXISTS('Packtemp:xdm.dsk') = 1 THEN ADDRESS COMMAND 'rename >NIL: packtemp:xdm.dsk to packtemp:Image.pak'
            IF EXISTS('Packtemp:xdm.image') = 1 THEN ADDRESS COMMAND 'rename >NIL: packtemp:xdm.image to packtemp:Image.pak'
            IF packer = 6 THEN DO
               ADDRESS COMMAND 'rename >NIL: packtemp:Image.pak to packtemp:Image.dsq'
               ADDRESS COMMAND 'rename >NIL: packtemp:Files.pak to packtemp:Files.dsq'
            END
            IF packer >2 & packer ~= 6 THEN DO
               IF frage = 0 THEN CALL drivetest
               lister set fenster_s progress name 'Ich Convertiere!'
               dopus getfiletype 'Packtemp:Image.pak id'
               testpack = RESULT
               IF testpack = "PKD" THEN DO
                  ADDRESS COMMAND 'wait 1'
                  ADDRESS COMMAND 'PackDev packtemp:Image.pak '||tr||drive||tr||' ETDF NC NV'
                  IF RC >5 THEN CALL fehler
               END
               IF testpack ~= "PKD" THEN DO
                  ADDRESS COMMAND 'wait 1'
                  ADDRESS COMMAND 'DD -c1760 -w '||tr||drive||tr||' Packtemp:Image.pak'
                  IF RC >5 THEN CALL fehler
               END
            END
            IF packer >2 & packer ~= 6 THEN ADDRESS COMMAND 'delete >NIL: packtemp:#? ALL'
            IF pause = 1 THEN BREAK
         END
         CALL sense
         IF signal = 0 THEN DO
            lister set fenster_s progress name 'Teste: '||drive
            zusatz = ""
            ADDRESS COMMAND 'TestDevice '||tr||drive||tr
            xt = RC
            IF xt = 0 THEN DO
               ADDRESS COMMAND 'DirII >Ram:Testfile '||tr||drive||tr||' ALL NOINFO LFORMAT %l'
               OPEN('test','Ram:Testfile','READ')
               tx = READLN('test')
               CLOSE('test')
               ADDRESS COMMAND 'delete >NIL: Ram:Testfile QUIET FORCE'
               IF VALUE('tx') <1 THEN xt = 1
            END
            IF xt = 0 & packer ~= 3 THEN ADDRESS COMMAND 'DirII >Packtemp:Files.pak all sizes width=64 '||tr||drive||tr
            IF xt ~= 0 THEN DO
               zusatz = " ALL";zzs = " NOZERO";zzx = ""
               ADDRESS COMMAND 'echo >Packtemp:Files.pak "Diskette leer oder keine gültige DOS-Disk!!"'
            END
            IF packer = 6 THEN ADDRESS COMMAND 'rename >NIL: Packtemp:Files.pak to Packtemp:Files.dsq'
         END
         IF pause = 0 & packer < 3 | packer = 6 THEN DO
            IF arc = 0 THEN DO
               lister set fenster_s progress name 'Ich Convertiere!'
               ADDRESS COMMAND 'wait 1'
               ADDRESS COMMAND 'PackDev '||tr||drive||tr||' Packtemp:Image.pak '||zusatz||' NC NV'
               IF RC >5 THEN CALL fehler
               IF EXISTS('Packtemp:Image.pak.PKD') = 0 THEN DO
                  dopus request '"Achtung!! Fehler beim (Ent)Packen!!!" Nächstes|Abbruch'
                  abbruch = RC
                  IF abbruch = 0 THEN CALL schluss
                  pause = 1
               END
            END
            IF pause = 0 THEN DO
               IF arc = 0 & packer ~= 6 THEN ADDRESS COMMAND 'Rename Packtemp:Image.pak.PKD to Packtemp:Image.pak'
               IF arc = 0 & packer = 6 THEN ADDRESS COMMAND 'Rename Packtemp:Image.pak.PKD to Packtemp:Image.dsq'
               IF packer = 1 THEN imagefile = LEFT(unpackfile,LASTPOS('.',unpackfile))||"pkx"
               IF packer = 2 THEN imagefile = LEFT(unpackfile,LASTPOS('.',unpackfile))||"pka"
               IF packer = 6 THEN imagefile = LEFT(unpackfile,LASTPOS('.',unpackfile))||"dsq"
               IF EXISTS('ziel:'||imagefile) = 1 THEN DO
                  IF loesch = 0 THEN DO
                     dopus request '"Es existiert bereits ein File mit dem gleichen Namen!!'||lf||'Das muß gelöscht werden!!" Ja|Nein'
                     IF RC = 1 THEN loesch = 2
                  END
               IF loesch > 0 THEN ADDRESS COMMAND 'delete >NIL: '||tr||'ziel:'||imagefile||tr||' QUIET FORCE'
               IF loesch = 2 THEN loesch = 0
               END
               CALL sense
               lister set fenster_s progress name 'Packe: '||imagefile
               IF packer = 1 | packer = 6 THEN ADDRESS COMMAND 'LZX -m -3 -bo256 -X0 -Y a '||tr||'ziel:'||imagefile||tr||' Packtemp:(Image|Files)#?'
               IF packer = 2 THEN ADDRESS COMMAND 'LHA -m -X -b256 -Z a '||tr||'ziel:'||imagefile||tr||' Packtemp:(Image|Files)#?'
               IF RC >5 THEN CALL fehler
               ADDRESS COMMAND 'DELETE >NIL: Packtemp:#? QUIET FORCE'
               CALL sense
            END
         END
         IF packer = 3 & pause = 0 THEN DO
            CALL sense
            IF subpack = "SUBPACK" THEN CALL xpacker
            imagefile = LEFT(unpackfile,LASTPOS('.',unpackfile)-1)
            lister set fenster_s progress name 'Packe: '||imagefile||'.pkd'
            ADDRESS COMMAND 'wait 1'
            ADDRESS COMMAND 'PackDev '||tr||drive||tr||' '||tr||'ziel:'||imagefile||tr||' P '||subpack||zusatz||' NC NV'
            IF RC >5 THEN CALL fehler
         END
         IF packer = 4 & pause = 0 THEN DO
            CALL sense
            say
            say "DMS arbeitet im Hintergrund!"
            say
            imagefile = LEFT(unpackfile,LASTPOS('.',unpackfile)-1)
            lister set fenster_s progress name 'Packe: '||imagefile||'.DMS'
            ADDRESS COMMAND 'wait 1'
            ADDRESS COMMAND 'DMS READ '||tr||'ziel:'||imagefile||tr||' FROM '||tr||drive||tr||zzs||' <NIL: >NIL:'
            IF RC >5 THEN CALL fehler
         END
         IF packer = 5 & pause = 0 THEN DO
            CALL sense
            imagefile = LEFT(unpackfile,LASTPOS('.',unpackfile)-1)||'.zom'
            lister set fenster_s progress name 'Packe: '||imagefile
            ADDRESS COMMAND 'wait 1'
            ADDRESS COMMAND 'zoom From '||tr||drive||tr||' To '||tr||'ziel:'||imagefile||tr||zzx||' N'
            IF RC >5 THEN CALL fehler
         END
         IF loesch = 1 & pfad_s = pfad_d THEN DO
            ADDRESS COMMAND 'DELETE '||tr||'quelle:'||unpackfile||tr||' QUIET FORCE'
         END
      END
       IF arc = 1 & pause = 0 THEN DO
          CALL sense
             namef = LEFT(unpackfile,LASTPOS('.',unpackfile)-1)
             IF packer = 1 THEN namez = namef||'.lzx'
             IF packer = 2 THEN namez = namef||'.lha'
             IF EXISTS('ziel:'||namez) = 1 THEN DO
                IF loesch = 0 THEN DO
                   dopus request '"Es existiert bereits ein File mit dem gleichen Namen!!'||lf||'Das muß gelöscht werden!!" Ja|Nein'
                   IF RC = 1 THEN loesch = 2
                END
                IF loesch = >0 THEN ADDRESS COMMAND 'delete >NIL: '||tr||'ziel:'||namez||tr||' QUIET FORCE'
                IF loesch = 2 THEN loesch = 0
             END
             CALL sense
             lister set fenster_s progress name 'Packe: '||namez
             IF packer = 1 | packer = 3 THEN ADDRESS COMMAND 'LZX -m -3 -bo256 -e -r -Y a '||tr||'ziel:'||namef||tr||' Packtemp:#?'
             IF packer = 2 THEN ADDRESS COMMAND 'LHA -F -e -r -b256 -Z a '||tr||'ziel:'namef||tr||' Packtemp:#?'
             IF RC >5 THEN CALL fehler
          END
          ADDRESS COMMAND 'wait 1'
          ADDRESS COMMAND 'DELETE >NIL: Packtemp:#? ALL QUIET FORCE'
       END
   END
pause = 0
packtyp = ""
arc = 0
zzs = ""
zzx = " D B"
END
RETURN

ENTPACKEN:
anweisung = UPPER(COMPRESS(message,' "'))
IF anzahl < 1 THEN DO
   dopus request '"Oh Mann!: Irgendetwas solltest du schon anhaken!" OK'
   CALL schluss
END
laufwerk = "pack"
lister set fenster_s busy 1
lister set fenster_d busy 1
IF pfad_s = pfad_d & anweisung ~= "NOASK" THEN DO
   dopus request '"Quell - und Ziellister sind gleich!!'||lf||'Die Quellfiles werden (teilweise) gelöscht!" Weiter|Abbruch'
   IF RC = 0 THEN CALL schluss
END
abbruch = 0
pause = 0
x = 0
zzy = ""
IF anzahl >3 THEN ADDRESS COMMAND 'resident >NIL: C:xfdDcrunch pure'
lister set fenster_s progress anzahl 'Entpacke File(s):'
DO FOREVER
   x = x+1
   lister query fenster_s firstsel
   IF RC ~= 0 THEN LEAVE
   xfile = RESULT
   unpackfile = STRIP(xfile,B,' "')
   lister query fenster_s entry xfile
   yfile = RESULT
   lister select fenster_s xfile 0
   lister set fenster_s progress count x
   dopus getfiletype 'quelle:'||xfile id
   packtyp = UPPER(RESULT)
   IF packtyp ="DMS"|packtyp="PKD"|packtyp="XMS"|packtyp="PKX"|packtyp="PKA"|packtyp="DSQ"|packtyp="XDM"|packtyp="ZOM" THEN DO
      IF frage = 1 THEN CALL diskwechsel
      IF frage = 0 THEN CALL DRIVETEST
      IF abbruch = 1 | frage = 2 THEN BREAK
   END
   IF packtyp = "ZOM" THEN DO
      IF LEFT(drive,2) = "DF" THEN zzy = " V"
   END
   IF packtyp = "DMS" THEN DO
      say
      say "DMS ist am Werkeln!"
      say
   END
   SELECT
         WHEN packtyp = "LZX" THEN befehl = 'LZX -m -X0 x '||tr||'quelle:'||unpackfile||tr||' ziel:'
         WHEN packtyp = "LHA" THEN befehl = 'LHA -F -m -X x '||tr||'quelle:'||unpackfile||tr||' ziel:'
         WHEN packtyp = "DSQ" THEN befehl = 'PackDev Packtemp:Image.dsq '||tr||drive||tr||' ETDF NC NV'
         WHEN packtyp = "DMS" THEN befehl = 'DMS WRITE '||tr||'quelle:'||unpackfile||tr||' to '||tr||drive||tr||' NOTEXT NOPAUSE <NIL: >NIL:'
         WHEN packtyp = "PKD" THEN befehl = 'PackDev '||tr||'quelle:'||unpackfile||tr||' '||tr||drive||tr||' NC NV'
         WHEN packtyp = "PKX" | packtyp = "PKA" THEN befehl = 'PackDev Packtemp:Image.pak TO '||tr||drive||tr||' ETDF NC NV'
         WHEN packtyp = "XMS" THEN befehl = 'XMash WRITE '||tr||'quelle:'||unpackfile||tr||' TO '||tr||drive||tr
         WHEN packtyp = "AMPK" THEN befehl = 'AMIPACK-X '||tr||'quelle:'||unpackfile||tr||' ziel:'
         WHEN packtyp = "ZIP" THEN befehl = 'Unzip -o '||tr||'quelle:'||unpackfile||tr||' -d ziel:'
         WHEN packtyp = "ZOM" THEN befehl = 'zoom  From '||tr||'quelle:'||unpackfile||tr||' To '||tr||drive||tr||zzy||' N'
         WHEN packtyp = "ZOO" THEN befehl = "Gehtnicht"
         OTHERWISE befehl = "NOP"
   END
   IF befehl = "NOP" THEN DO
      IF WORD(yfile,2) = "-1" THEN DO
         IF pfad_s ~= pfad_d THEN ADDRESS COMMAND 'makedir >NIL: '||tr||'ziel:'||unpackfile||tr
         befehl = 'xfdDecrunch '||tr||'quelle:'||unpackfile||tr||' '||tr||'ziel:'||unpackfile||tr||' FORCE ALL NA CA'
         packtyp = "DIR"
      END
      IF WORD(yfile,2) ~= "-1" THEN befehl = 'xfdDecrunch '||tr||'quelle:'||unpackfile||tr||' ziel: FORCE ALL NA CA'
   END
   IF abbruch = 1 | frage = 2 THEN LEAVE
   CALL sense
   lister set fenster_s progress name packtyp': '||unpackfile
   IF packtyp="PKX" | packtyp = "PKA" | packtyp="DSQ" | packtyp="XDM" THEN DO
      IF packtyp ~= "PKA" THEN ADDRESS COMMAND 'LZX -m -X0 x '||tr||'quelle:'||unpackfile||tr||' Packtemp:'
      IF packtyp = "PKA" THEN ADDRESS COMMAND 'LHA -F -m -X x '||tr||'quelle:'||unpackfile||tr||' Packtemp:'
      IF RC >5 THEN CALL FEHLER
      IF abbruch ~= 0 THEN BREAK
      IF EXISTS('Packtemp:xDM.image') = 1 THEN befehl = 'PackDev Packtemp:xDM.image '||tr||drive||tr||' ETDF NC NV'
      IF EXISTS('Packtemp:xdm.pkd') = 1 THEN DO
         dopus getfiletype 'Packtemp:xdm.pkd id'
         testpack = RESULT
         IF testpack ~= "PKD" THEN befehl = 'DD -c1760 -w '||tr||drive||tr||' Packtemp:xdm.pkd'
      END
      IF EXISTS('Packtemp:xdm.dsk') = 1 THEN DO
         dopus getfiletype 'Packtemp:xdm.dsk id'
         testpack = RESULT
         IF testpack ~= "PKD" THEN befehl = 'DD -c1760 -w '||tr||drive||tr||' Packtemp:xdm.dsk'
      END
   END
   CALL sense
   IF pause = 0 THEN ADDRESS COMMAND befehl
   IF RC >5 THEN CALL FEHLER
   ADDRESS COMMAND 'DELETE >NIL: Packtemp:#? QUIET FORCE'
   IF abbruch = 1 | frage = 2 THEN DO
      IF anzahl >3 &  THEN ADDRESS COMMAND 'resident >NIL: xfdDcrunch remove'
   END
   IF abbruch = 1 | frage = 2 THEN LEAVE
packtyp = ""
pause = 0
zzy = ""
END
RETURN

PACKEN:
lister set fenster_s busy 1
lister set fenster_d busy 1
anweisung = UPPER(STRIP(message,B,' "'))
IF anzahl = 0 & crunch = "" THEN packer = 4
IF crunch ~= "" & crunch ~= "CRUNCH" THEN DO
   crunch = UPPER(STRIP(crunch,B,' "'))
   SELECT
      WHEN crunch = "LZX" THEN packer = "LZX"
      WHEN crunch = "LHA" THEN packer = "LHA"
      WHEN crunch = "XPK" THEN packer = "XPK"
      WHEN crunch = "LZXMASH" THEN packer = "LZXM"
      WHEN crunch = "LHAMASH" THEN packer = "LHAM"
      WHEN crunch = "XMASH" THEN packer = "XMASH"
      WHEN crunch = "DMS" THEN packer = "DMS"
      WHEN crunch = "DSQ" THEN packer = "DSQ"
      WHEN crunch = "ZOM" THEN packer = "ZOM"
      OTHERWISE NOP
   END
   IF packer = "LZX" | packer = "LHA" | packer = "XPK" THEN DO
      IF anzahl = 0 THEN DO
         dopus request '"Wenn Du nichts selektiert hast,'||lf||'kann ich nichts packen!!" OK'
         CALL schluss
      END
   END
   IF LENGTH(crunch) > 3 THEN DO
      IF LEFT(crunch,5) = "XMASH" THEN DO
         packer = "XMASH"
         subpack = SUBSTR(crunch,7)
         IF VALUE(SUBSTR(crunch,15)) = 0 THEN packer = 0
      END
      IF LEFT(crunch,3) = "XPK" THEN DO
         packer = "XPK"
         subpack = SUBSTR(crunch,5)
         IF VALUE(SUBSTR(crunch,8)) = 0 THEN packer = 0
      END
   END
END
IF packer = 0 THEN DO
   dopus request '"Welcher Packer darf es denn sein ?" LZX|LHA|XPK|DiskPacker|Abbruch'
   packer = RC
SELECT
   WHEN packer = 0 THEN CALL schluss
   WHEN packer = 1 THEN packer = "LZX"
   WHEN packer = 2 THEN packer = "LHA"
   WHEN packer = 3 THEN packer = "XPK"
   OTHERWISE packer = 4
END
END
IF packer = 4 THEN DO
   dopus request '"Disk-Packen ist angesagt !! *** Da hätten wir zum Beispiel:" LZXMash|LHAMash|XPKMash|DSQMash|DMS|Zoom|Ende'
   mash = RC
   SELECT
      WHEN mash = 0 THEN CALL schluss
      WHEN mash = 1 THEN packer = "LZXM"
      WHEN mash = 2 THEN packer = "LHAM"
      WHEN mash = 3 THEN packer = "XMASH"
      WHEN mash = 4 THEN packer = "DSQ"
      WHEN mash = 5 THEN packer = "DMS"
      WHEN mash = 6 THEN packer = "ZOM"
      OTHERWISE NOP
   END
END
IF packer = "LHA" | packer = "LZX" THEN DO
   xname = "";i = 0;a = 0;n = 0
   dopus getstring '"Bitte den Namen des Archivs eingeben!" 40 "" OK|Abbruch'
   namef = RESULT
   IF namef = "RESULT" | dopusrc = 0 THEN CALL schluss
   IF anzahl >30 THEN DO
      IF packer = "LZX" THEN ADDRESS COMMAND 'resident >NIL: c:LZX pure'
      IF packer = "LHA" THEN ADDRESS COMMAND 'resident >NIL: c:LHA pure'
   END
   lister set fenster_s progress anzahl 'Kaffeepause!! Ich archiviere:'
   DO FOREVER
      CALL sense
      i = i +1
      lister query fenster_s firstsel
      n = RC
      IF n = 0 THEN DO
         xfile = RESULT
         packfile = tr||"quelle:"||STRIP(xfile,B,' "')||tr||' '
         lister select fenster_s xfile 0
         a = a+1
         lister set fenster_s progress name Packe bis':' STRIP(xfile,B,' "')
         lister set fenster_s progress count a
         xname = xname||packfile
      END
      IF i = 15 | n ~= 0 & xname ~= "" THEN DO
         IF packer = "LHA" THEN ADDRESS COMMAND 'LHA -F -m -b256 -e -r -Z a ziel:'||namef xname
         IF packer = "LZX" THEN ADDRESS COMMAND 'LZX -m -3 -bo256 -e -r -Y a ziel:'||namef xname
         i = 0;xname = ""
      END
      IF n ~= 0 THEN DO
         IF anzahl >30 THEN DO
            IF packer = "LZX" THEN ADDRESS COMMAND 'resident >NIL: LZX remove'
            IF packer = "LHA" THEN ADDRESS COMMAND 'resident >NIL: LHA remove'
         END
      IF n ~= 0 THEN LEAVE
      END
   END
END
IF packer = "XPK" THEN DO
   IF subpack = "SUBPACK" THEN CALL xpacker
   exec = ""
   IF anzahl >1 THEN dopus request '"Sollen alle Files gepackt werden, oder nur Datenfiles?'||lf||'*** Achtung!! Verzeichnisse werden nicht beabeitet!! ***" Alles|All.o.info|Daten|Dat.o.info|Abbruch'
   z = RC
   IF z = 0 THEN CALL schluss
   IF z = 1 | z = 2 THEN exec = " EXECUTABLE"
   IF pfad_s = pfad_d & UPPER(STRIP(message,B,' "')) ~= "NOASK" THEN DO
      dopus request '"Quell- und Zielpfad sind identisch!!'||lf||'Die Quelldateien werden gelöscht!!" OK|Abbruch'
      IF RC = 0 THEN CALL schluss
   END
   IF anzahl >3 THEN ADDRESS COMMAND 'resident >NIL: C:XpackIt pure'
   lister set fenster_s progress anzahl 'Kaffeepause!! Ich packe File(s):'
   i = 0
   pause = 0
   DO FOREVER
      CALL sense
      i = i +1
      lister query fenster_s firstsel
      n = RC
      IF n = 0 THEN DO
         xfile = RESULT
         packfile = tr||"quelle:"||STRIP(xfile,B,' "')||tr
         lister query fenster_s entry xfile
         yfile = RESULT
         dirtest = WORD(yfile,2)
         IF dirtest = "-1" THEN DO
            say
            say packfile||" Ist eine Verzeichnis"
            say "Das wird nicht bearbeitet"
            say
            pause = 1
         END
         lister select fenster_s xfile 0
         dopus getfiletype 'quelle:'||xfile id
         packtyp = UPPER(RESULT)
         IF packtyp = "ICON" THEN DO
            IF z = 2 | z = 4 THEN pause = 2
         END
         lister set fenster_s progress count i
         IF pause = 0 | pause = 2 THEN DO
            lister set fenster_s progress name XPK': '||STRIP(xfile,B,' "')
            IF pause = 0 THEN ADDRESS COMMAND 'XPackIt '||packfile||' ziel: METHOD '||subpack||exec||' PACK'
            IF EXISTS('ziel:'||STRIP(xfile,B,' "')) = 0 THEN DO
            lister set fenster_s progress name 'Kopiere: '||STRIP(xfile,B,' "')
               say
               say "Das File "||xfile||" wird kopiert!!"
               say
               ADDRESS COMMAND 'Copy '||packfile||' to '||tr||'ziel:'||STRIP(xfile,B,' "')||tr||' QUIET CLONE NOREQ'
            END
         END
      END
      pause = 0
      IF n ~= 0 & anzahl >3 THEN ADDRESS COMMAND 'resident >NIL: XpackIt remove'
      IF n ~= 0 THEN LEAVE
   END
END
IF packer="DMS"|packer="LHAM"|packer="LZXM"|packer="XMASH"|packer="DSQ"|packer="ZOM" THEN DO
   IF anweisung ~= "NOASK" THEN DO
      dopus request '"Achtung!!'||lf||'Die Disk wird in das angewählte Verzeichnis gepackt!!" Ok|Ende'
      IF RC = 0 THEN CALL schluss
   END
   CALL DRIVETEST
   IF abbruch = 1 THEN CALL schluss
   dopus request '"Sollen mehrere Disketten gepackt werden ?" Nein|Ja|Abbruch'
   diskzahl = RC
   IF diskzahl = 0 THEN CALL schluss
   xyz = 0
   IF diskzahl = 2 THEN lister set fenster_s progress 25 'Archiviere Diskette(n):'
   IF diskzahl = 1 THEN lister set fenster_s progress 1 'Archiviere Diskette(n):'
   a=0
   zzy = " D B"
   DO FOREVER
      a = a+1
      IF a >25 THEN DO
         lister clear fenster_s progress
         lister clear fenster_s abbort
         lister set fenster_s progress 25 'Archiviere Diskette(n):'
      END
      pause = 0
      dopus getstring '"Bitte den Archivnamen eingeben!'||lf||'Achtung!! Die Diskette wird in das Verzeichnis:'||lf||pfad_s||' gepackt!!" 40 "" OK|Abbruch'
      archiv = RESULT
      IF archiv = "RESULT" | dopusrc = 0 THEN CALL schluss
      IF xyz = 1 THEN CALL diskwechsel
      IF frage = 2 THEN LEAVE
      lister set fenster_s progress name 'Teste Quelldisk'
      xyz = 1
      zusatz = ""
      ADDRESS COMMAND 'TestDevice '||tr||drive||tr
      xt = RC
      IF xt = 0 THEN DO
         ADDRESS COMMAND 'DirII >Ram:Testfile '||tr||drive||tr||' ALL NOINFO LFORMAT %l'
         OPEN('test','Ram:Testfile','READ')
         tx = READLN('test')
         CLOSE('test')
         ADDRESS COMMAND 'delete >NIL: Ram:Testfile QUIET FORCE'
         IF VALUE('tx') <1 THEN xt = 1
      END
      CALL sense
      lister set fenster_s progress count a
      IF packer = "DMS" THEN DO
         IF xt >0 THEN zusatz = " NOZERO"
         lister set fenster_s progress name DMS': '||drive # archiv||.DMS
         CALL sense
         say
         say "DMS ist bei der Arbeit!"
         say
         ADDRESS COMMAND 'DMS READ '||tr||'quelle:'||archiv||tr||' FROM '||tr||drive||tr||zusatz||' <NIL: >NIL:'
      END
      IF packer = "ZOM" THEN DO
         IF xt >0 THEN zzy = ""
         lister set fenster_s progress name Zoom': '||drive # archiv||.zom
         CALL sense
         ADDRESS COMMAND 'zoom from '||tr||drive||tr||' To '||tr||'quelle:'||archiv||'.zom'||tr||zzy||' N'
      END
      IF packer = "XMASH" THEN DO
         IF subpack = "SUBPACK" THEN CALL xpacker
         IF xt >0 THEN zusatz = " ALL"
         lister set fenster_s progress name XPK': '||drive # archiv||.DMS
         CALL sense
         ADDRESS COMMAND 'wait 1'
         ADDRESS COMMAND 'PackDev '||tr||drive||tr||' '||tr||'quelle:'||archiv||tr||' P '||subpack||zusatz||' NC NV'
      END
      IF packer = "LHAM" | packer = "LZXM" | packer = "DSQ" THEN DO
         IF xt = 0 THEN DO
            IF packer ~= "DSQ" THEN ADDRESS COMMAND 'DirII >Packtemp:Files.pak all sizes width=64 '||tr||drive||tr
            IF packer = "DSQ" THEN ADDRESS COMMAND 'DirII >Packtemp:Files.dsq all sizes width=64 '||tr||drive||tr
         END
         IF xt ~= 0 THEN DO
            zusatz = " ALL"
            IF packer ~= "DSQ" THEN ADDRESS COMMAND 'echo >Packtemp:Files.pak "Disk leer oder keine gültige DOS-Disk!!"'
            IF packer = "DSQ" THEN ADDRESS COMMAND 'echo >Packtemp:Files.dsq "Disk leer oder keine gültige DOS-Disk!!"'
         END
         lister set fenster_s progress name packdev': '||drive # Temp
         CALL sense
         ADDRESS COMMAND 'wait 1'
         ADDRESS COMMAND 'PackDev '||tr||drive||tr||' Packtemp:Image.pak'||zusatz||' NC NV'
         IF EXISTS('Packtemp:Image.pak.PKD') = 0 THEN DO
            dopus request '"Achtung!! Fehler beim (Ent)Packen!!!" Nächstes|Abbruch'
            IF RC = 0 THEN CALL schluss
            pause = 1
            BREAK
         END
         IF pause = 0 THEN DO
            IF packer ~= "DSQ" THEN ADDRESS COMMAND 'Rename >NIL: Packtemp:Image.pak.PKD to Packtemp:Image.pak'
            IF packer = "DSQ" THEN ADDRESS COMMAND 'Rename >NIL: Packtemp:Image.pak.PKD to Packtemp:Image.dsq'
            IF packer = "LZXM" THEN imagefile = archiv||".pkx"
            IF packer = "LHAM" THEN imagefile = archiv||".pka"
            IF packer = "DSQ" THEN imagefile = archiv||".dsq"
            CALL sense
            IF packer = "LZXM" | packer = "DSQ" THEN DO
               lister set fenster_s progress name LZX': '||Temp # imagefile
               ADDRESS COMMAND 'LZX -m -3 -X0 -U0 -Y a '||tr||'quelle:'||imagefile||tr||' Packtemp:#?'
            END
            IF packer = "LHAM" THEN DO
               lister set fenster_s progress name LHA':' Temp # imagefile
               ADDRESS COMMAND 'LHA -F -m -X -Z a '||tr||'quelle:'||imagefile||tr||' Packtemp:#?'
            END
            ADDRESS COMMAND 'DELETE >NIL: Packtemp:#? QUIET FORCE'
         END
      END
      IF diskzahl = 1 THEN LEAVE
      zzy = " D B"
   END
END
RETURN

DRIVETEST:
IF packtyp ~= "XMS" THEN DO
   IF auftrag ~= "CONVERT" THEN dopus request '"Welches Laufwerk soll verwendet werden ?" DF0:|DF1:|RAD:|HF0:|Anderes'
   IF auftrag = "CONVERT" THEN dopus request '"Welches Laufwerk soll zur '||lf||'Konvertierung verwendet werden ?" DF0:|DF1:|RAD:|HF0:|Anderes'
   x = RC
   SELECT
         WHEN x = 1 THEN drive = "DF0:"
         WHEN x = 2 THEN drive = "DF1:"
         WHEN X = 3 THEN drive = "RAD:"
         WHEN X = 4 THEN drive = "HF0:"
         OTHERWISE drive = "XXX"
   END
   IF drive = "XXX" THEN DO
      dopus getstring '"Was darf es denn sein?" 15 "DF2:" OK|Abbruch'
      IF DOPUSRC = 0 THEN abbruch = 1
      drive = RESULT
      IF abbruch = 1 | drive = "RESULT" THEN CALL schluss
   END
END
IF packtyp = "XMS" THEN DO
   dopus request '"ACHTUNG !! XMash kann nur Diskettenlaufwerke unterstützen'||lf||'Welches Laufwerk soll verwendet werden ?" DF0:|DF1:|DF2:|DF3:|Abbruch'
   x = RC
   SELECT
         WHEN x = 0 THEN abbruch = 1
         WHEN x = 1 THEN drive = "DF0:"
         WHEN x = 2 THEN drive = "DF1:"
         WHEN X = 3 THEN drive = "DF2:"
         WHEN X = 4 THEN drive = "DF3:"
         OTHERWISE NOP
   END
END
IF abbruch = 0 THEN DO
   ADDRESS COMMAND 'Assign >NIL: '||tr||drive||tr||' exists'
   IF RC ~= 0 THEN DO
      ADDRESS COMMAND 'mount >NIL: '||tr||drive||tr
      IF RC ~= 0 THEN DO
         dopus request '"Mann eh, das Laufwerk kriege ich nicht gebacken!" OK'
         abbruch = 1
      END
   END
   frage = 1
   IF abbruch ~=1 & LEFT(drive,2) = "DF" THEN DO
      IF laufwerk ~="" THEN laufwerk = " ungeschüzte "
      dopus request '"Ist eine'||laufwerk||'Diskette'||lf||'Im Laufwerk '||drive||' eingelegt?" OK|Ende'
      IF RC = 0 THEN CALL schluss
   END
END
RETURN


diskwechsel:
frage = 1
dopus request '"Hast du die Diskette gewechselt?" Ja|Anderes Laufwerk|Abbruch'
lwf = RC
IF lwf = 0 THEN frage = 2
IF lwf = 2 THEN CALL DRIVETEST
RETURN

FEHLER:
dopus request '"Da ist was schief gelaufen!!" Abbruch|Nächstes'
abbruch = RC
IF abbruch = 0 THEN pause = 1
IF abbruch = 1 THEN CALL schluss
RETURN

BREAK_C:
CALL SCHLUSS
RETURN

XPACKER:
dopus request '"Welcher XPK-Packer darf es denn sein ?" RAKE|SQSH|SHRI|NUKE|IMPL|Andere|Abbruch'
x = RC
IF x ~= 6 THEN xpk = x
IF x = 6 THEN DO
   xpk = 5
   dopus request '"Dann hätten wir da noch :" BLZW|CBR0|DHUF|FAST|GZIP|Andere|Abbruch'
   x = RC
   IF x = 0 THEN xpk = 0
   IF x ~= 6 THEN xpk = xpk + x
END
IF x = 6 THEN DO
   xpk = 10
   dopus request '"Ach ja, da sind ja auch noch :" HFMN|HUFF|LHLB|MASH|NONE|Andere|Abbruch'
   x = RC
   IF x = 0 THEN xpk = 0
   IF x ~= 6 THEN xpk = xpk + x
END
IF x = 6 THEN DO
   xpk = 15
   dopus request '"Wehe, es schreibt einer nochn Packer! Also:" RCDN|RLEN|SMPL|Abbruch'
   x = RC
   IF x = 0 THEN xpk = 0
   IF x ~= 6 THEN xpk = xpk + x
END
SELECT
   WHEN xpk = 0 THEN CALL schluss
   WHEN xpk = 1 THEN xpk = "RAKE"
   WHEN xpk = 2 THEN xpk = "SQSH"
   WHEN xpk = 3 THEN xpk = "SHRI"
   WHEN xpk = 4 THEN xpk = "NUKE"
   WHEN xpk = 5 THEN xpk = "IMPL"
   WHEN xpk = 6 THEN xpk = "BLZW"
   WHEN xpk = 7 THEN xpk = "CBR0"
   WHEN xpk = 8 THEN xpk = "DHUF"
   WHEN xpk = 9 THEN xpk = "FAST"
   WHEN xpk = 10 THEN xpk = "GZIP"
   WHEN xpk = 11 THEN xpk = "HFMN"
   WHEN xpk = 12 THEN xpk = "HUFF"
   WHEN xpk = 13 THEN xpk = "LHLB"
   WHEN xpk = 14 THEN xpk = "MASH"
   WHEN xpk = 15 THEN xpk = "NONE"
   WHEN xpk = 16 THEN xpk = "RCDN"
   WHEN xpk = 17 THEN xpk = "RLEN"
   WHEN xpk = 18 THEN xpk = "SMPL"
   OTHERWISE NOP
END
IF packer = "XPK" | packer = "XMASH" | packer = 3 THEN DO
   dopus request '"Tja dann haben wir noch die Packrate'||lf||'Bitte wählen Sie:" 50%|75%|100%|Andere|Ende'
   rate = RC
   SELECT
      WHEN rate = 0 THEN CALL schluss
      WHEN rate = 1 THEN subpack = xpk||".50"
      WHEN rate = 2 THEN subpack = xpk||".75"
      WHEN rate = 3 THEN subpack = xpk||".100"
      OTHERWISE NOP
   END
   IF rate = 4 THEN DO
      dopus getstring '"Bitte die Packrate eingeben:" 3 "" OK|Abbruch'
      rate = RESULT
      IF rate = "RESULT" | dopusrc = 0 THEN CALL schluss
      subpack = xpk||"."||rate
   END
END
RETURN

SENSE:
lister query fenster_s abort
sx = RESULT
IF sx ~=0 THEN DO
   dopus request '"Wirklich abbrechen ?" Ja|Nein'
   IF RC = 1 THEN CALL schluss
   lister clear fenster_s abort
END
RETURN

SYNTAX:
PULL
CALL schluss
RETURN